Date: 2022-06-03
R version: 3.5.0
*Corresponding author: matthew.malishev [at] gmail.com
This document can be found at https://github.com/darwinanddavis/UsefulCode

Overview

Same deal as Useful Code 1 and 2 except just gglot because it's too difficult sifting through the other docs.

ggplot functions

Remove annoying stock gridlines from plot window

# option 1
p1 <- p + labs(title = "Option 1") + theme_classic()
p1

# option 2 with inputs to toggle
p2 <- p + labs(title = "Option 2") + theme_bw() + theme(panel.border = element_blank(), panel.grid.major = element_blank(), 
    panel.grid.minor = element_blank(), axis.line = element_line(colour = "black"))
p2
# alternative (after loading ggridges library) theme_ridges(grid=F,center_axis_labels = T)

Setting global graphics theme for ggplot

plot_it_now <- function(bg) {
    # bg = colour to plot bg
    theme(panel.border = element_blank(), panel.grid.major = element_blank(), panel.grid.minor = element_blank(), 
        panel.background = element_rect(fill = bg, colour = bg), plot.background = element_rect(fill = bg)) + 
        theme(axis.line = element_line(color = "white")) + theme(axis.ticks = element_line(color = "white")) + 
        theme(plot.title = element_text(colour = "white")) + theme(axis.title.x = element_text(colour = "white"), 
        axis.title.y = element_text(colour = "white")) + theme(axis.text.x = element_text(color = "white"), 
        axis.text.y = element_text(color = "white")) + theme(legend.key = element_rect(fill = bg)) + 
        theme(legend.title = element_text(colour = "white")) + theme(legend.text = element_text(colour = "white"))
}
plot_it_now("black")

Put plot in function to take dynamic data inputs

Ref: http://jcborras.net/carpet/visualizing-political-divergences-2012-local-elections-in-helsinki.html

hr.mass.plot <- function(d) {
    p <- ggplot(d, aes(HR, Mass, color = colfunc)) + geom_density_2d(data = d, aes(x = HR, y = Mass), 
        stat = "density2d", position = "identity", color = adjustcolor("orange", alpha = 0.8), size = 1.5, 
        contour = T, lineend = "square", linejoin = "round")
    p <- p + geom_point(data = d, aes(x = HR, y = Mass), color = colfunc, fill = colfunc) + scale_color_manual(values = magma(8))
    p <- p + scale_y_continuous(limits = c(-200, 200), name = "Mass lost (g)")
    p <- p + scale_x_continuous(limits = c(0, 0.35), name = expression("Home range area (km^2)"))
    p <- p + theme_classic()
    print(p)
}
hr.mass.plot(d)

Using ggplot when looping through for loop and saving to dir

pdf("mypdf.pdf", onefile = T)
for (i in 1:3) {
    par(bty = "n", las = 1)
    grid.arrange(ggplot(data, aes(x = X, y = Y, fill = ..x..)) + geom_point() + labs(title = paste0("Title_", 
        i)) + xlab("X") + ylab("Y"))
}
# end loop
dev.off()



# geom_density_ridges() # scale = overlap

# geom_density_ridges(scale = 5, size=0.2,color='white', rel_min_height = 0.01,fill=col,alpha=0.5) +

# scale_fill_viridis option = 'magma', 'inferno','plasma', 'viridis', 'cividis'

Converting lists and dataframes to usable format for ggplot (melt package)

require(reshape2)  # melt package   
nn <- 10  # reps
mm <- data.frame(X = rep(LETTERS, nn), Y = sample(nn, replace = T), Z = rep(paste(LETTERS, "_", rnorm(1)), 
    nn))
# plot
y_m <- melt(mm)
head(y_m)
ggplot(data = y_m, aes(x = X, y = value, group = Z, colour = factor(value))) + geom_point(aes(size = value)) + 
    geom_line() + theme_classic()

Insert math expression in plot or legend title

xx = sample(100, 100)
yy = rnorm(100)

title1 <- bquote("Density = " ~ r[xy] ~ "and" ~ B^2 ~ +beta ~ alpha)
ggplot() + geom_point(aes(x = xx, y = yy), color = xx) + labs(title = title1, xlab = title1, yab = title1, 
    colour = title1)

Create double line break with expression in legend title (and labels)

ggplot() + scale_color_manual(expression(atop("text", atop(textstyle(epsilon)))))

ggplot() + scale_color_manual(name = expression(atop("Productivity", atop(textstyle((mg ~ C ~ L^{
    -1
} ~ d^{
    -1
})  # this is bracketed text
)))))

Adding text lables to plots

require(ggplot2)
xx = sample(100, 100)
yy = rnorm(100)
df <- data.frame(X = xx, Y = yy)

ggplot(df) + geom_point(aes(xx, yy, size = 5), colour = xx, show.legend = F) + geom_text(aes(xx, yy, 
    label = xx), check_overlap = T, size = yy + 5) + theme_classic()

# add bg label
ggplot() + geom_line(aes(xx, yy, size = 5), colour = xx, show.legend = F) + geom_label(aes(xx, yy, label = xx), 
    size = yy + 5, color = yy + 5, fill = xx) + theme_classic()

Add text only to final point (plus other methods)

require(directlabels)
df <- tibble("x" = sample(10,5),
             "y" = sample(10,5),
             "label" = LETTERS[1:5])

ggplot() +
  geom_point(data = df, aes(x,y)) +
  geom_dl(aes(label = label), 
          method = list(
            dl.trans(x = x + 0.3, y = y + 0), # expand x/y axis to fit in labels  
            list(dl.combine("first.points","last.points")), cex = 0.5 # add labels to first and last points
            )
          ) +
  scale_x_continuous( ..., expand = c(0, 1.5))

Calling data frame columns with weird formatting

# use ticks, not quotations

require(ggplot2)
df <- data.frame(X = rnorm(1000), `Y col with spaces` = sample(1000, replace = T))

# incorrect y col, but doesn't throw error
ggplot(df, aes(X, "Y col with spaces")) + geom_line()

# same issue even when matching col name
ggplot(df, aes(X, "Y.col.with.spaces")) + geom_line()

# usable y col
ggplot(df, aes(X, Y.col.with.spaces)) + geom_line()

Use POSIX format

Code Meaning
%a Abbreviated weekday
%A Full weekday
%b Abbreviated month
%B Full month
%c Locale-specific date and time
%d Decimal date
%H Decimal hours (24 hour)
%I Decimal hours (12 hour)
%j Decimal day of the year
%m Decimal month
%M Decimal minute
%p Locale-specific AM/PM
%S Decimal second
%U Decimal week of the year (starting on Sunday)
%w Decimal Weekday (0=Sunday)
%W Decimal week of the year (starting on Monday)
%x Locale-specific Date
%X Locale-specific Time
%y 2-digit year
%Y 4-digit year
%z Offset from GMT
%Z Time zone (character)

require(nycflights13);require(dplyr);require(ggplot2)
flights %>% str
flights$time_hour %>% class # already posix
flights_mod <- flights$time_hour %>% as.character() # convert posix to character

# turn into posix year month day hour minute second format
require(lubridate)
flights_mod <- flights_mod %>% ymd_hms()  
flights_mod %>% class

# make new df with fewer data 
df <- data.frame("Date"=flights_mod[1:100000],
                 "Delay"=flights$arr_delay[1:100000])

ggplot(df, aes(Delay,Date)) + geom_tile() +
  scale_y_datetime(date_breaks = "1 month", 
                   date_minor_breaks = "1 week", # optional 
                   date_labels = "%B %Y" # full month and year
                  ) +
  theme_classic()

Plotting multiple plots per window (with different plot size ratios) with gridExtra

require(gridExtra)

nn <- 100 # create sample
p <- ggplot()+geom_point(aes(sample(nn,replace=T),rnorm(nn),size=runif(nn),color=rainbow(nn)),show.legend = F)+theme_classic()

# put plots into list 
ggplot_list <- list(p,p,p,p)

# 3 plots above, 1 below
grid.arrange(
  grobs = ggplot_list, # list with ggplots or grobs
  widths = c(1, 1, 1),
  layout_matrix = rbind(c(1, 2, 3),
                        c(4, 4, 4))
)

# 3 plots above with first plot 2 plots wide 
grid.arrange(
  grobs = ggplot_list, # list with ggplots or grobs
  widths = c(2, 1, 1), # widths (2,1,1) of total plots for each row (3) 
  layout_matrix = rbind(c(1, 2, 3), 
                        c(4, 4, 4))
)

# 2 plots below with third plot 3 plots wide 
grid.arrange(
  grobs = ggplot_list, # list with ggplots or grobs
  widths = c(2, 1, 1),
  layout_matrix = rbind(c(1, 2, NA),
                        c(3, 3, 4))
)

Arranging multiplot panels

# https://patchwork.data-imaginist.com/articles/guides/assembly.html
# devtools::install_github('thomasp85/patchwork')
require(patchwork)

p1 <- ggplot(mtcars) + geom_point(aes(mpg, disp, col = cyl), show.legend = F) + ggtitle("Plot 1") + theme_classic()
p2 <- ggplot(mtcars) + geom_point(aes(mpg, cyl, col = disp), show.legend = F) + ggtitle("Plot 2") + theme_classic()

p3 <- p1
p4 <- p2

# 2 plots, 2 cols
p1 + p2

# multi rows
(p1 | p2 | p3)/p4  # 3 plots top, 1 bottom (2 rows)  

p1/(p2 | p3)  # 1 plot top, 2 bottom (2 rows)  

# 2 plots, 2 rows and 2 cols
wrap_plots(p1, p2, p3, p4)

# 3 plots, 2 cols
patch <- p1 + p2
p3 + patch

# non ggplot content eg. text
p1 + grid::textGrob("Some text")

p1 + gridExtra::tableGrob(mtcars[1:10, c("mpg", "disp")])

# title, subs, and captions
patchwork <- (p1 + p2)/p3
patchwork + plot_annotation(title = "ttl", subtitle = "subttl", caption = "caption")

Setting legend to custom aes elements, e.g. color, shape, linetype

# set 'labs' arguments to same title as in 'scale_color_manual'
# legend values automatically matches arguments passed to colvec
# NB specifying the labels arg in scale_color_manual overrides labs  

require(ggplot2)

snack_df <- data.frame(
  "X"=sample(100,10,replace=F),
  "Y"=sample(100,10,replace=F),
  "Sum"=runif(10),
  "Size"=rep(LETTERS[1:5],each=2)
)
colvec <- colorspace::sequential_hcl(length(unique(snack_df$Size)), "SunsetDark")
legend_ttl <- "This is your legend"
legend_pars <- unique(snack_df$Size) # not run
                       
ggplot(snack_df,aes(X,Y)) +
  geom_line(aes(group=Size,color=Size,linetype=Size),size=1) +
  geom_point(aes(group=Size,color=Size,shape=Size),size=3) +
  scale_color_manual(name=legend_ttl,
                     # labels = legend_pars, # this overrides labs 
                     values = colvec) +
  geom_text(aes(X,Y,
                label=c(Size)
                ),
            check_overlap = T,
            size=5,vjust=-1,hjust=1.2) +
  labs(title="Plot title",x="X",y="Y",
       # ----- these are the legend key arguments
       colour=legend_ttl,
       fill=legend_ttl,
       linetype=legend_ttl,
       shape=legend_ttl) + # check shape 
  theme_classic()

Pass variables as user arguments to plotting function

Option 1

# http://www.rebeccabarter.com/blog/2020-02-05_rstudio_conf/
require(tidyverse)
require(dplyr)
midwest %>% head
plotMidwestTidy <- function(var1, var2) {
    ggplot(midwest) + geom_point(aes(x = {
        {
            var1
        }
    }, y = {
        {
            var2
        }
    }  # wrap vars in double curly braces  
))
}

plotMidwestTidy(popdensity, poptotal) + theme_bw()

Option 2 Can't use character class as user argument

require(ggplot2)
my_theme <- theme_classic()
colour_var <- "class"
facet_var <- "drv"

ggplot(mpg) + geom_point(aes(displ, hwy, colour = colour_var)) + facet_wrap(vars(facet_var)) + my_theme

Placing .data in front of your variables and wrapping them with double square braces '[[]]' solves this.

require(ggplot2)
my_theme <- theme_classic()
colour_var <- "class"
facet_var <- "drv"

ggplot(mpg) + geom_point(aes(displ, hwy, colour = .data[[colour_var]])) + facet_wrap(vars(.data[[facet_var]])) + 
    my_theme + ggtitle(paste0(colour_var, " vs ", facet_var))

Use conditional statements in ggplot objects

require(ggplot2)
cond1 <- F
cond2 <- T
p <- ggplot(mtcars) + geom_point(aes(mpg, hp, size = 3), show.legend = F) + theme_classic()
p <- p + if (cond1 == T) {
    # execute condition 1 and add to plot
    geom_line(aes(mpg, hp, size = 3), color = "red", show.legend = F)
}
p <- p + if (cond2 == T) {
    # execute condition 2 and add to plot
    geom_line(aes(mpg, hp, size = 2), color = "blue", show.legend = F)
}
p

Make calendar plot

require(sugrrants)
require(nycflights13)
ff <- flights
ff <- ff %>% mutate(date = flights$time_hour %>% as.Date())
fdf <- frame_calendar(ff, x = distance, y = arr_delay, date = date, nrow = 4)
p <- ggplot(fdf) + geom_line(aes(x = .distance, y = .arr_delay, group = date)) + theme_void()
p %>% prettify()

Plot benchmark results

https://stackoverflow.com/questions/29803253/r-extracting-coordinates-from-spatialpolygonsdataframe

res <- microbenchmark(raster::geom(atf_sp), ggplot2::fortify(atf_sp), spbabel::sptable(atf_sp), as.data.frame(as(as(atf_sp, 
    "SpatialLinesDataFrame"), "SpatialPointsDataFrame")))
ggplot2::autoplot(res)

Flip and rotate plots

# rotate
print(p, vp = viewport(angle = -30))
p + coord_flip()
p + scale_y_reverse()
graphics.off()

Images

Fill plot view with image

require(png)
require(jpeg)
imgr <- img %>% readPNG()
ggplot() + annotation_raster(imgr, -Inf, Inf, -Inf, Inf)

Fill geom with patterns/images https://coolbutuseless.github.io/package/ggpattern/index.html

Read in png, recolor, write as svg, and append to df

here::here("img",paste0(ifh,".png")) %>% 
  image_read(strip = T) %>% 
  # image_scale(c(100,100)) %>% 
  image_fill("transparent") %>%
  image_colorize(color = colv_hi,opacity = 70) %>%  # recolor img
  image_write(here::here("img",paste0(ifh,"2.png")) ,format = "png", depth=NULL)

# append to df 
df$img <- here::here("img",paste0(ifh,"2.png"))

Create custom geom

library(ggplot2)
x <- 1:100

my_geom_y <- function(yy, colour = "black") {
    list(geom_line(aes(y = yy), col = colour), data = data.frame(x, yy), geom_point(aes(y = yy), col = colour, 
        data = data.frame(x, yy)))
}

ggplot(aes(x)) + my_geom_y(x, "red") + my_geom_y(dlnorm(x), "blue") + my_geom_y((x^1.1), "black") + my_geom_y(x/2, 
    "yellow")

Highlight variables in plot

library(ggplot2)
library(gghighlight)
ggplot(mpg, aes(x = cty, y = hwy)) + geom_point(color = "red", size = 2) + gghighlight(class == "midsize")

Set inner circle width for circular barplot

ylim <- 40
ggplot() + geom_histogram(data = d, aes(xx, id, fill = yy), size = 0, position = "stack", stat = "identity", 
    show.legend = F) + scale_fill_manual(values = adjustcolor(colv, 1), aesthetics = c("col", "fill")) + 
    facet_wrap(~zz) + theme_classic() + coord_polar(start = 0.25) + scale_x_continuous(breaks = 1:12, 
    labels = xtick) + # option 1
scale_y_continuous(expand = c(0.2, 0)) + # option 2
scale_y_continuous(limits = c(-10, NA), breaks = seq(0, ylim, ylim/4), labels = seq(0, ylim, ylim/4))

Add histogram dist to boxplots (from Eli data)

limits <- d$yy %>% unique
colv <-  colorspace::sequential_hcl(limits, "Blues")
require(ggdist)
ggplot(data = d, aes(x = xx, y = yy, 
                     col = yy, fill = yy
                     )) +
  geom_boxplot(outlier.color = NA) + # boxplot
  geom_jitter(height = 0.2) + # jitter points
  ggdist::stat_dots(binwidth = 0.2, # opt 1: dot plot
                    side = "left", 
                    justification = 1.1,
                    col = NA) + 
  ggdist::stat_halfeye(slab_type = "pdf",
                       limits = c(1, NA), # rm data < 1
                       adjust = 0.5, # opt 2: point dist
                       width = 0.5, 
                       .width = 0, # decrease iqr line width
                       justification = -0.5, # move dist above box
                       point_colour = NA) +
  scale_y_discrete(limits=limits) + # reorder xaxis
  scale_colour_manual(values = colv,aesthetics = "col", limits = limits, labels = limits) + # keep solid col for boxplot
  scale_fill_manual(values = adjustcolor(colv,0.7), aesthetics = "fill",limits = limits, labels = limits) + # add alpha to boxplot fill
  theme_classic()

Insert plot inset within main plot

### opt 1 first create and save plot inset to local dir
plot_inset <- ggplot() + geom_point(data = inset_data)
# 
ggsave("plot_inset.png", plot_inset)
plot_inset <- "plot_inset.png" %>% readPNG()  # read in saved plot

# main plot
ggplot() + geom_sf(data = data) + # add plot inset
annotation_raster(plot_inset, xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax) + # themes
theme_nothing()

### opt 2
ggdraw() + draw_plot(main1, 0, 0, 1, 1) + draw_plot(legend1, 0.15, 0.7, 0.18, 0.18)

Legends

Custom shape for legend

# ?draw_key # see available glyphs 
require(ggplot2)
require(dplyr)
require(colorspace)

glyph <- "pointrange"
df <- data.frame(xx = rep(1:5,each=3),
                 yy = 1:15,
                 group = rep(c("A","B","C"),each=5))
ggplot(data=df,aes(xx,yy,col = group, fill = group)) + 
  geom_line(key_glyph = glyph) + # set shape for legend
  scale_fill_discrete_sequential(name = paste0(glyph, " legend"), "Reds", aesthetics = "col") +
  theme_bw() +
  guides(col = guide_legend(
    override.aes = list(size = 1)  # set custom legend size 
    ))

Fine tune legend features e.g. text, padding, vertical/horizontal spacing

df <- data.frame(xx = sample(100, 100), yy = rnorm(100))
ggplot(data = df, aes(xx, yy, col = yy, fill = yy)) + geom_point() + theme_classic() + theme(legend.position = "bottom") + 
    # legend guide for colourbar
guides(fill = guide_colorbar(title = "Continuous", label.position = "left")) + # legend guid for categorical
guides(fill = guide_legend(title = "Categorical", label.position = "right"))

Toggle legend when using scale_*_() functions

ggplot() + geom_point(data = df, aes(fill = var1)) + scale_fill_manual(values = colpal, aesthetics = "fill", 
    guide = F)  # T/F to toggle show legend

Customise attributes of two separate legends e.g. size and colour bar

# set colourbar for var1 (color gradient) but also change colour/fill of legend for var2 (size)

ggplot() + geom_sf(data = df, aes(col = var1, fill = var1, size = var2)) + # var 1 attributes (colour/fill gradient)
scale_fill_gradientn(name = title1, colours = adjustcolor(colpal, 0.5), aesthetics = c("col", "fill"), 
    na.value = "#EFEFEF") + # var 2 attributes (size)
guides(size = guide_legend(title = title2, override.aes = list(fill = col_var2, alpha = 0.5, col = col_var2)  # change colour for size legend (var2)
))

Change legend font, size, bg, opacity, and position

opac <- 0.5
theme(legend.position=c(0.2,0.2), #xy from bottom left
        legend.key.size = unit(0.5, "cm"), # size
        legend.background = element_rect(fill=alpha(fg, opac)), # legend background
        legend.title = element_text(family = family,colour = col_font),
        legend.text = element_text(family = family,colour = col_font)
  )

Biscale legend 

require(biscale)

data <- bi_class(df, sf1, sf2, dim = 3)
legend <- bi_legend(pal = "GrPink",
                    dim = 3,
                    xlab = "More sf1",
                    ylab = "More sf2",
                    size = 12)
map <- ggplot() +
  geom_tile(data = data , aes(x = x, y = y, fill = bi_class), show.legend = F) +
  bi_scale_fill(pal = "GrPink", dim = 3) + # create biscale
  bi_theme()
  
# combine legend and map 
ggdraw() +
  draw_plot(map, 0, 0, 1, 1) +
  draw_plot(legend, 0.15, 0.7, 0.18, 0.18)

Axes

Add brackets to axes

# install.packages('lemon')
require(lemon)
ggplot() + geom_jitter(data = mpg, aes(cyl, hwy, colour = class), width = 0.2) + coord_flex_cart(bottom = brackets_horizontal(tick.length = 0))

Extract variable name as character

require(ggplot2)
require(palmerpenguins)
my_theme <- theme_classic()
plot_penguin <- function(v1, v2, v3) {
    var1 <- ensym(v1)  # turn var into character 
    var2 <- ensym(v2)
    var3 <- ensym(v3)
    ggplot(penguins) + geom_point(aes({
        {
            var1
        }
    }, {
        {
            var2
        }
    }, colour = {
        {
            var3
        }
    })) + my_theme + ggtitle(paste0(var1, " vs ", var2, " by ", var3))
}
plot_penguin(bill_depth_mm, bill_length_mm, species)

Text/titles

Set text behind plot area/map/data

ggplot() + geom_text(data = ttl, aes(x, y, label = label), check_overlap = T) + geom_sf(data = sf) + 
    coord_sf(crs = prj, xlim = c(bbox[1], bbox[3]), ylim = c(bbox[2], bbox[4])) + labs(x = NULL, y = NULL) + 
    # themes
theme_nothing() + theme(panel.grid.major = element_line(colour = border, linetype = 3, size = 0.2), plot.background = element_rect(fill = "transparent", 
    colour = NA), panel.background = element_rect(fill = "transparent"), axis.text = element_blank(), 
    axis.ticks.length = unit(0, "null"), plot.margin = unit(c(0.1, 0.1, 0.1, 0.1), "mm"), panel.ontop = F)

Customise ggplot text with colours

require(ggtext)
ttl <- paste0("<span style='font-family: Avenir;'>Climate risk in Vietnam <br>
<span style='font-size: 30pt'> Exposure of 
  <span style='color:",colv1,";'>Coffee</span>, 
  <span style='color:",colv2,";'>Cashew</span>, and 
  <span style='color:",colv3,";'>Cassava</span>  
  </span></span>") %>% purrr::map(htmltools::HTML)

p + theme(plot.title = element_markdown(lineheight = 1)) + # add custom ggtext
  labs(title = ttl) 

# vlist <- c(coff,cash,cass)
# lapply(vlist,function(x) {colnames(x) = rep(c('Index',"geometry"),times = vlist %>% length/2)})

Add curved arrows/points to text labels, unicode chars, math expressions, etc

require(ggrepel)
require(ggplot2)
set.seed(42)
ggplot(mtcars, aes(wt, mpg, label = carb)) + geom_point(color = "red") + geom_text_repel(nudge_x = 0.15, 
    box.padding = 0.5, nudge_y = 1, segment.curvature = -0.1, segment.ncp = 3, segment.angle = 20)